a 


Bas 


FFFFFFFFFRFFFFE 000000000 RRRRRRRRRRRR RRRRRRRRRRRR TITTTTTTTTTTTTT LLet 
FFFFFRFFRRFFFFE 000000000 RRRRRRRRRRRR RRRRRRRRRRRR TITTTTTTTTTTTFT Lie 
FFFFFRFRRRFFFFFE 000000000 RRRRRRRRRRRR RRRRRRRRRRRR TITTTTITTTTTTTT §=LtL 
FFF 000 000 RRR RRR RRR RRR TTT LLL 
FFF 000 000 RRR RRR RRR RRR TTT LLL 

FFF 000 RRR RRR RRR RRR TTT LLL 

FFF 000 000 RRR RRR RRR RRR TTT LLL 

FFF 000 000 RRR RRR RRR RRR TTT LLL 

FFF 000 000 RRR RRR RRR RRR TTT LLL 
FFFFFFFFFFFF 000 000 RRRRRRRRRRRR RRRRRRRRRRRR TTT LLL 
FFFFFFFFFFFE 000 000 RRRRRRRRRRRR RRRRRRRRRRRR TTT LLL 
FFFFFFFFFFFF 000 000 RRRRRRRRRRRR RRRRRRRRRRRR TTT LLL 

FFF 000 000 RRR RRR RRR = RRR TTT LLL 

FFF 000 000 RRR RRR RRR = =RRR TTT LLL 

FFF 000 RRR RRR RRR = RRR TTT LLL 

FFF 000 000 RRR RRR RRR RRR TTT LLL 

FFF 000 000 RRR RRR RRR RRR TTT LLL 

FFF 0 000 RRR RRR RRR RRR TTT LLL 

FFF 000000000 RRR RRR RRR RRR TTT LLLLLLLLLLELLLL 
FFF 000000000 RRR RRR RRR RRR TTT LLLLLLLLLLELLLL 
FFF 000000000 RRR RRR RRR RRR TTT LLLLELLLLLLLLLL 
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LOL LL LL LL LL LL LL LO LO LP LO LL LL LL 


**F 1LE**1D**F ORUNLOCK 


FFFFFFFFFE 000000 RRRRRRRR UU UU NN NN LL 000000 CCCCCCCC OCOKK KK 
FFFFFFFFFF 000000 RRRRRRRR UU UU NN NN LL 000000 cccccccc KK KK 

FF 00 00 RR RR UU UU NN NN LL 00 cc Ke KK 

FF 00 0O RR RR UU UU NN NN LL 00 oo CC KK KK 

FF 00 OO RR RR UU UU NNNN NN LL 00 00 CC KK KK 

FF 00 0O RR RR UU UU NNNN NN LL 00 oo CC KK K 

FFFFFFFF 00 00 RRRRRRRR UU UU NN NN NN LL 00 oo CC KKKKKK 

FFFFFFFF 00 00 RRRRRRRR UU UU NN NN NN LL 00 oo CC KKKKKK 

FF oe OO RR RR UU UU NN NNNN LL 00 oo CC KK K 

FF 00 00 RR RR UU UU NN NNNN LL 00 oo CC KK KR 

FF 00 00 RR RR UU UU NN NN LL 00 oo CC KK KK eves 
FF 00 00 RR RR UU UU NN NN LL 00 oo cc KK KK cece 
FF 000000 RR RR UUUUUUUUUU NN NN LLLLLLLLLL 000000 cccccccc KK KK eoee 
FF 000000 RR RR UUUUUUUUUU NN NN LLLLLLLLLL 000000 cccccccc KK KK cece 
LL IIIIII SSSSSSSS 

LL III1I] SSSSSSSS 

LL I] SS 

LL I] SS 

LL I] SS 

LL I] SS 

LL I] SSSSSS 

LL I] SSSSSS 

LL I] SS 

LL I] SS 

LL I] SS 

LL I] SS 

LELLLLLLLL III] SSSSSSSS 

LLLLLLLLLL HII] SSSSSSSS 


K R.. 
FORSUNLOCK 19° Sep 4 AX-11 Bliss-32 V4.0- Page 
14-Sep 1382 99: 38: & PORRTL SREdFORUN NLOCK. 5 2:1 . 
MODULE FORSUNLOCK ( ! ppp cements Cera UNLOCK stat Fengnt 
' File: FORUNLOCK.832 Edit: JBS100 


ow = '1=002' 
BEGIN 


Vee RRR RARER AERA RARE EAAAEE EEA AAA AAA RARER AAA ERERAEEE 


'® COPYRIGHT (c) 1978, 1980, 1982, 1984 BY 
!® DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS. 
't ALL RIGHTS RESERVED. 


1 ree SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED 
one ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE 
HI FTWARE OR ANY OTHER 


; T 
Hd COPIES THEREOF MAY NOT BE PROVIDED OR OTWERWISE MADE AVAILABLE TO ANY 
't OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY 


® 
& 
& 
® 
® 
s 
ae 
ae 
® 
ie TRANSFERRED. ‘ 
® 
® 
® 
* 
® 
te 
® 
7 
® 
® 


Coooocoo 


FWA A WA AMAIA PININIPININPININIDS 2 2 OOO OS MH DOOOOCOOOO 


pojololoelolo) 


* 

oe 
=z 
o 


ie THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE 
!* AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT 
!t CORPORATION. 

'® DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS 
SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. 


Lee AAA RARER AAA AAA ARATE AAA AAA AAA AERAKR ARE 
' 


++ 
FACILITY: FORTRAN Support Library - User Callable 
ABSTRACT: 


INI AIAWIAIAII PO POPU PU NUN NUNU RY 2 2 
FUN "OC OONOUSWN —O OONOUSWWN “OWOONOU ES Wwh— 
SOWONA VL WN $0 ODNOU EWN | O DONO AN" OODONOU ES Wr 


SoOOOOOOOSOOSOOoOoOOCOCOOCOOOCOOOCOOOOOOOCoOSoO 
Ft tataotatatatatatatatatatatatatetatatetotototetetetetetetotatatay 


' 
i 
i 
i 
i 
= This module implements the FORTRAN UNLOCK statement. 
4 ENVIRONMENT: User access mode; mixture of AST level or not. 
+4 AUTHOR: Steven B. Lionel, CREATION DATE: 17-May-1979 
41 0041 i MODIFIED BY: 
42 004 i 
43 004 i 1-001 - Original. SBL N ACTOALC . 
44 044 i 1-002 = Move the BUILTIN ACT AL COUNT into the routine, since the next 
45 045 i BLISS compiler will require it to be there. While we are here, 
46 004 i clean up the source text a Little. Note that this edit does not 
47 004 i change the code. JBS 22-Aug-1980 
48 Bpe8 ie 
49 049 


es ts 4 st ss 5 4 4 _ ts 2 p53 4 (DOO 
. -_ . 
gs 
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~~ 


FORSUNLOCK 
1-002 


, | 0051 
3 3g 08¢ 
3 2¢ 05 
3 5 054 
; 8656 0055 
3 ef ppe8 
; 8 005 
; FF BR3e 
: 60 005 
: 8 b0et 
3 eg 280 
s 64 491 
3 65 049 
; © 049 
; 67 0494 
; 68 0495 
; | 6D 0496 
; 70 0497 
.- a 0498 
. a 0499 
ie 2m 0500 
3; 6 66 0501 
; 75 e404 
; 76 050 
oo ae 0504 
Be. | pate 
: 79 057 
; & 0596 
s 861 0597 
co. of 069 
; ¢& 069 
: «B46 083 
; 8 0834 
5; & 0835 
s 67 ets] 
; 083 
; 6289 tty 
;s 0839 
; 91 peee 
3 9 841 
3; F Bats 
; (94 084 
s 95 see 
; 39 5 
; | «698 a8 
; 8 
; 100 0 

3 + 4 50 
.-4 ‘ 51 
; 10 Hu 
OR 
18 f 
; 109 336 
: 108 85 


ce ce ee ce ce ce ee ee ee ce ce ee ec cD ee ce ee ce ee DD ce ee ce ce ce ee ee ee ed ee ed ed ed 


SWITCHES: 


SWITCHES ADDRESSING_MODE (EXTERNAL = GENERAL, NONEXTERNAL = WORD_RELATIVE); 
' 


LINKAGES: 


REQUIRE "RTLIN:OTSLNK'; ! define all Linkages 
i] 


; TABLE OF CONTENTS: 


FORWARD ROUTINE 
FORSUNLOCK; 


FORTRAN UNLOCK statement 


; INCLUDE FILES: 


LIBRARY ‘RTLSTARLE'; 
REQUIRE 'RTLML:FORERR'; 
REQUIRE "RTLML:FORPAR’; 
REQUIRE ‘RTLIN:RTLPSECT'; 
REQUIRE "RTLML:OTSLUB'; 


System symbols 
FORTRAN error number definitions 


Inter-module constants 
Define DECLARE_PSECTS macro 
Get LUB offsets 


| MACROS: 

: NONE 

i EQUATED SYMBOLS: 

NONE 

| OWN STORAGE: 

NONE 

| EXTERNAL REFERENCES: 

eer EPORSS IOSTAT HND 
FORSSSIGNAL~STO : NOVALU 


LUE, 
FORS$CB_PUSA : JSB_CB_PUSH NOVALUE, 
FORS$CB-POP : JSB_CB_POP NOVALUE; 


Error handler 

convert error code and signal 
Get a control block 

Return a control block 


i PSECT DECLARATIONS: 


3 
1B-Sen-1984 00:56:44 YAK=I1 BLisg-52 v4.007 


~_— wm 


oO-- 


DECLARE_PSECTS (FOR); 


Sect GB:H8:85 YAGI OLS BR tata” 


FORUNLOCK. ‘ 


! Declare PSECTS for FORS facility 


ws 


nN 3 
FORSUNLOCK 16-Sep-1984 00:56:44 AX-11 Bliss-32 v4.0 
1-009 kee. 3B 99:38:86 FORRTL.SRC FORUNLOCK. age, 31 
; 133 p86) } GLOBAL ROUTINE FORSUNLOCK (UNIT, ERR_EQL) = 
ce eee 
; 118 64 1 ! FUNCTIONAL DESCRIPTION: 
s; 11 bbe? 1 i 
; #118 £68 1 Call CB_PUSH to get a control block for this UNIT. 
: 119 0867 1: Do an RAS SFREE on the unit. 
: 131 984 : Return 10 system to previous state. 
» % ¢ 0890 1/ FORMAL PARAMETERS: 
; V2 0871 1: 
: \$e B58 1 i UNIT. rlu.y Unit number (call by value) 
s 125 873 1: ERR EQL. = If 1, return IOSTAT value 
$ 139 Bate : If omitted or zero, signal all errors 
; 128 Bare 1 § IMPLICIT INPUTS: 
5 +4 0877 1: 
; 130 0878 1: LUBSV_OPENED 1 if file previously opened 
: 13 + 144 : LUBSV_NOTSEQORG 1 if file not sequential organization 
;: 133 0881 1 ' IMPLICIT OUTPUTS: 
: «(134 oes 1 i 
s 155 0883 1: 
3; 136 0884 1 i ROUTINE VALUE: 
: 137 0885 1: 
; «4138 paee 1} An IOSTAT value. 
3; «4139 0887 1! 
: 140 0888 1 | SIDE EFFECTS: 
> (141 0889 1: 
: +} 0890 1: ao locked | records on the unit are unlocked. If the unit is 
; «(14 0891 1} anon r is not relative or indexed organization, the error 
> 144 0892 1: FORS CERR = UNLOCK error 
> «(145 0893 1! is signalled. 
: 146 0894 1} 
3 147 0895 1 i- 
; «148 0896 1 
: 149 089 BEGIN 
; 150 0898 
: 151 0899 00m, ahesisien 
3 13¢ 0900 K_CCB_REG : REF BLOCK C, BYTE); 
, 3 0901 
: «154 090 BUILTI 
: 132 090 ACTUAL COUNT; 
i 48 308 
; 158 aoe UNWIND_ACTION : VOLATILE, 
3; 159 90 LER EQC_PRES : “VOLATILE, 
: 160 3 ATUS; 
: 161 90 
: 166 910 
: 16 11 MAE ERSSIOSTAT HND (L_LUNWIND_ACTION, L_ERR_EQL_PRES); 
: 188 318 
; 196 Bie "set up unwind action and flag if ERR= or IOSTAT was present. 
: 168 BIS L_LUNWIND_ACTION = FORSK_UNWINDNOP; 
; 169 091 


Page ; 


| 4 
PORSUMLOCK 18-Sep-1984 90:36:64 AX-11 Bliss-32 V4.0-74 Page 5 


14-Sep-1 FORRTL.SRCJFORUNLOCK.852;1 (3) 

3 170 318 IF (ACTUALCOUNT () GTR 1) THEN L_ERR_EQL_PRES = .ERR_EQL ELSE L_ERR_EQL_PRES = 0; 

: 17 920 2 !+ 

: 138 921 ' Get a LUB for this unit. 

3 \ee 2 § On return, CCB points to the current control block. 

: 176 3 4 , FORSSCB_PUSH (.UNIT, LUBSK_LUN_MIN); 

: 178 4 § Error action is now to pop the LUB. 

: 180 09 : " LLUNWIND ACTION = FORSK_UNWINDPOP; 

; 136 $9 Q i If the file is not open or is not relative or indexed organization, 

> 18 0931 i signal error FOR$_UNLERR. 

: 18s oo8s 5 

: 186 0934 IF (( NOT .CCB CLUBSV_OPENED]) OR ( NOT .CCB CLUBSV_NOTSEQORG])) THEN FORSS$SIGNAL_STO (FORSK_UNLERR) ; 

: 1s b98 5 16 

: 189 $339 i Now unlock the file. Signal errors except for RMS$_RNL which we 

; 190 0938 ! choose to ignore (no records were locked). 

: 133 0940 3 

; 198 0941 IF ( NOT SFREE (RAB = .CCB)) 

; 6194 094 § THEN 

; 13? Sh BEGIN 

; P44 epee 3 WHILE {CCB CRABSL_STS] EQL RMS$_RSA) DO 

: 199 0947 4 SWAIT (RAB = .CCB); 

: 200 0948 5 SFREE (RAB = .CCB) 

: $03 $950 3 le 

: 208 bees 4 IF (( NOT .CCB CRABSL_STS]) AND (.CCB CRABSL_STS] NEQU RMS$_RNL)) : 

: 205 $983 ; FORSSSIGNAL_STO (FORSK_UNLERR); 

3 $96 0954 

3 07 0955 END; 

: $06 $98 3 1 

; $19 3338 Return the 1/0 system to its last state. | 

; si 0960 FORSSCB_POP (); | 

: 14 096 Return a success IOSTAT code 

; 316 0964 2 RETURN 0; | 

> 217 0965 1 END; ! of routine FORSUNLOCK | 
TITLE FORSUNLOCK | 
SIDENT \1-002\ 
LEXTRN FORSSIOSTAT_HND | 

-EXTRN FORSSSIGNAL STO | 
-EXTRN FORSS$CB_PUSA FORSS$CB_POP 
“EXTRN SYSSFREE, SYSSWAIT 


eo paca 
1-00 


1 
1 


081C 
4 000000006 E o3 
$3 Goooooo0s 80 3 
E 4 ¢ 1 
E—E 0 1 
04 AE D4 1 
60 006D ff Dd 01 
04 AE 1 3 1D 
01 ¢ 1 
6 8 & 
6E 08 AC 00 00026 
02 11 QO02A 
oF D4 0002C 
D4 000 F 
52 04 at 00 8 0 
000000006 00 16 000 
04 AE D4 OO03A 
05 FC ag E9 0003D 
05 Al AB 9 EO 4499 
8 0D 00046 
63 01 FB 00048 
5B DD 00048 
64 01 FB 00040 
2D 50 £8 Baas 
Q00182DA = BF 08 AB 01 0005 
10 12 00058 
5B DD 00050 
000000006 00 01 FB OO05F 
5B 0D $46 
64 01 FB 00068 
E6 11 00068 
OF 08 AB €E8 0006D 
000181A0 = 8F 08 AB 01 00071 
F 13 00079 
8 DD 00078 
63 01 FB 00070 
000000006 00 16 00080 
50 D4 it 
: 00 
0 a baat * 0089 
5) Ok AG (BO O00RF 
F8 AO OF Bar 
FC AQ OF a8 
ge dD 
E 0 98 
43 04 Ag Dd 9D 
000000006 0 05 FB QOOAI 
04 000A8 


; Routine Size: 169 bytes, Routine Base: 


:; 218 0966 1 


_FORSCODE + 0000 


nNn— 


3$: 
4$: 


5$: 


6$: 


7$: 


8$: 


Aw 


pa19Be 12:38:89 


»PSECT 


AX-11 Ot iegete V4.0-74 
FORRTL.SRCJFORUNLOCK.B32;1 
_FORSCODE,NOWRT, SHR, PIC,2 
FORSUNLOCK, Save R2,R3,R4,R11 
SYSSFREE, R4 
FORSSSIGNAL_ STO, R3 
L_ERR_EQL_PRES 

UNWIND_ACTION 

$, (FP) 
#1, L_UNWIND_ACTION 
(AP), "#1 

RR_EQL, L_ERR_EQL_PRES 
L_ERR_EQL_PRES 
RO 
UNIT, R2 
FORS$$CB_PUSH 
L VINE ACTION 
"3 -95(CCB), 4$ 
#1, FORSSSIGNAL_STO 
#1, SYSSFREE 


R 
g¢CB). #99034 


B 
#1, SYSSWAIT 
» SYSSFREE 
CcB), 7$ 
CCB), #98720 


, FORSS$SIGNAL_STO 
RS$CB_POP 


nothin 
S ] 


R 
EQL_PRES 
NWIND_ACTION 


RBLEYaOIT SOY DW BB NOOVBOBVO 


POS Re Re Ree Oe He Se Oe Se Be Oe Oe Oe Oe Oe Be Se Be Oe Se Se Se Be Be Be Be Se Be Se Be Se Se Be Fe Se Se Be Se Se Fe Se Ge Ge Se Be Se 


2 6 


FOR OCK 16-Sep-1984 AX-11 Bliss-32 v4.0 Page 
eet dae eats PRE eC Pee ht Sh pn ae . 
: 19 967 1 END ' of module FORSUNLOCK 

: 396 B38 1 : 

3 1 969 0 ELUDOM 

; PSECT SUMMARY 

: Name Bytes Attributes 

: _FORSCODE 169 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) 

: Library Statistics 

: wocecee= Symbols -------- Pages Processing 

: File Total Loaded Percent Mapped ime 

: _$255$DUA28:CSYSLIBISTARLET.L32;1 9776 8 0 581 00:01.0 


; COMMAND QUALIFIERS 
PL-SSEPEMECE SEP EELS AMET EAL OPT RISE) PUOTAACE A, 5M. 15517 CROCE IORI GRIEF OMAR. OCR MSRC$:F ORUNLOCK/UPDATE=(ENHS$: FORUNLOCK 


0 data bytes 


: Lexenes/CPU-Rin: 3 380 
; pee Used: 110 pages 
; Compilation Complete 


T CORPORATION 
PROPRIETARY 


018 AH-BT13A-SE DIGI 
VAX/VMS V4.0 CONF 


